home *** CD-ROM | disk | FTP | other *** search
/ Amiga News 95 / Amiga News 95.iso / dpat / dpat86 / bm / bordermaker.p < prev    next >
Text File  |  1994-06-12  |  25KB  |  796 lines
  1. pROGRAM BorderMaker;
  2.  
  3. {$I "include:libraries/reqtools.i"}
  4. {$I "include:utils/stringlib.i"}
  5. {$I "include:utils/CycleGad.i"}
  6. {$I "include:utils/PCQMemory.i"}
  7.  
  8. CONST
  9.  
  10.         STDFont : textAttr = ("topaz.font",8,FS_NORMAL,FPF_ROMFONT);
  11.         UDRFont : textattr = ("topaz.font",8,FSF_UNDERLINED,FPF_ROMFONT);
  12.  
  13.  
  14.         StdInName : Address = Nil;             {Pour ne pas avoir de fenêtre lors}
  15.         StdOutName: Address = Nil;             {de l'execution à partir du WB}
  16.  
  17. {Fenêtre des opérations}
  18.  
  19. win : NewWindow = (0,0,374,120,-1,-1,GADGETDOWN_f + GADGETUP_f + CLOSEWINDOW_f + RAWKEY_f,
  20.                                  WINDOWDRAG + WINDOWDEPTH + WINDOWCLOSE + ACTIVATE,
  21.                                  nil,nil,"BorderMaker v1.0r",nil,nil,-1,-1,-1,-1,
  22.                                  WBENCHSCREEN_f);
  23.  
  24. {Paires de points pour le nom du fichier et le nom de la structure}
  25.  
  26.         FSOpairs1 : array[1..3,1..2] of short = ((-5,10),(-5,-3),(243,-3));
  27.         FSOpairs2 : array[1..3,1..2] of short = ((-4,9),(-4,-3),(243,-3));
  28.         FSOpairs3 : array[1..3,1..2] of short = ((-4,10),(244,10),(244,-3));
  29.         FSOpairs4 : array[1..3,1..2] of short = ((-4,10),(243,10),(243,-2));
  30.  
  31.         FSOborder4 : border = (0,0,1,0,JAM2,3,@FSOpairs4,nil);
  32.         FSOborder3 : border = (0,0,1,0,JAM2,3,@FSOpairs3,@FSOborder4);
  33.         FSOborder2 : border = (0,0,2,0,JAM2,3,@FSOpairs2,@FSOborder3);
  34.         FSOborder1 : border = (0,0,2,0,JAM2,3,@FSOpairs1,@FSOborder2);
  35.  
  36.         FSIpairs1 : array[1..3,1..2] of short = ((-3,9),(-3,-2),(241,-2));
  37.         FSIpairs2 : array[1..3,1..2] of short = ((-2,8),(-2,-2),(241,-2));
  38.         FSIpairs3 : array[1..3,1..2] of short = ((-2,9),(242,9),(242,-2));
  39.         FSIpairs4 : array[1..3,1..2] of short = ((-2,9),(241,9),(241,-1));
  40.  
  41.         FSIborder4 : border = (0,0,2,0,JAM2,3,@FSIpairs4,@FSOBorder1);
  42.         FSIborder3 : border = (0,0,2,0,JAM2,3,@FSIpairs3,@FSIborder4);
  43.         FSIborder2 : border = (0,0,1,0,JAM2,3,@FSIpairs2,@FSIborder3);
  44.         FSIborder1 : border = (0,0,1,0,JAM2,3,@FSIpairs1,@FSIborder2);
  45.  
  46. {Pour les 'STRGADGET', gadgets de chaînes, il est nécéssaire de décaler
  47.  de quelques pixels vers le haut et vers la droite les bords, sinon
  48.  le texte empiéte dessus. De même, il est nécéssaire de declarer la
  49.  longueur et la largeur du gadget plus petit que réelle du fait du
  50.  décalage : la zone d'activation du gadget sera décalée vers le bas
  51.  et vers la droite d'autant que les bords en haut et à gauche le sont}
  52.  
  53. {Gadget pour le nom du fichier}
  54.  
  55.         FInfo : StringInfo = ("\0                                                                                                                                                                                                       ",
  56.                                      "\0                                                                                                                                                                                                       ",
  57.                                      0,200,0,0,0,0,0,0,nil,0,nil);
  58. {Pour la stucture StringInfo, toujours procéder de la même maniére :
  59.  si votre gadget contient au maximum x caractéres, mettre le champs
  60.  'MaxChars' à x, et mettre dans 'Buffer' et 'UndoBuffer' un nombre
  61.  caractére egal à x, le '\0' compris dans x. '\0' est obligatoire.
  62.  Il faut mettre tout les autres champs à 0 ou 'nil'
  63.  
  64.  TOUT AUTRE FORME D'INITIALISATION APPELLE LE GURU}
  65.  
  66.         FText0 : intuitext = (1,0,JAM2,-57,-5,@STDFont,"Nom du",nil);
  67.         FText1 : intuitext = (1,0,JAM2,-57,4,@STDFont,"ichier",@FText0);
  68.         FText2 : intuitext = (1,0,JAM2,-65,4,@UDRFont,"F",@FText1);
  69.  
  70.         F : Gadget = (nil,105,19,242,8,GADGHCOMP,RELVERIFY + GADGIMMEDIATE,
  71.                           STRGADGET,@FSIBorder1,nil,@FText2,0,@FInfo,1,nil);
  72.  
  73. {Gadget pour le nom de la strucure}
  74.  
  75.         SInfo : StringInfo = ("\0                                             ",
  76.                                      "\0                                             ",
  77.                                      0,46,0,0,0,0,0,0,nil,0,nil);
  78.  
  79.         SText0 : intuitext = (1,0,JAM2,-81,-5,@STDFont,"Nom de la",nil);
  80.         SText1 : intuitext = (1,0,JAM2,-73,4,@STDFont,"tructure",@SText0);
  81.         SText2 : intuitext = (1,0,JAM2,-81,4,@UDRFont,"S",@SText1);
  82.  
  83.         S : Gadget = (nil,105,38,242,8,GADGHCOMP,RELVERIFY + GADGIMMEDIATE,
  84.                           STRGADGET,@FSIBorder1,nil,@SText2,0,@SInfo,2,nil);
  85.  
  86. {Paires de points pour la longueur, la largeur, l'offset en X et
  87.  l'offset en Y}
  88.  
  89.         LHOpairs1 : array[1..3,1..2] of short = ((-5,10),(-5,-3),(36,-3));
  90.         LHOpairs2 : array[1..3,1..2] of short = ((-4,9),(-4,-3),(36,-3));
  91.         LHOpairs3 : array[1..3,1..2] of short = ((-4,10),(37,10),(37,-3));
  92.         LHOpairs4 : array[1..3,1..2] of short = ((-4,10),(36,10),(36,-2));
  93.  
  94.         LHOborder4 : border = (0,0,1,0,JAM2,3,@LHOpairs4,nil);
  95.         LHOborder3 : border = (0,0,1,0,JAM2,3,@LHOpairs3,@LHOborder4);
  96.         LHOborder2 : border = (0,0,2,0,JAM2,3,@LHOpairs2,@LHOborder3);
  97.         LHOborder1 : border = (0,0,2,0,JAM2,3,@LHOpairs1,@LHOborder2);
  98.  
  99.         LHIpairs1 : array[1..3,1..2] of short = ((-3,9),(-3,-2),(34,-2));
  100.         LHIpairs2 : array[1..3,1..2] of short = ((-2,8),(-2,-2),(34,-2));
  101.         LHIpairs3 : array[1..3,1..2] of short = ((-2,9),(35,9),(35,-2));
  102.         LHIpairs4 : array[1..3,1..2] of short = ((-2,9),(34,9),(34,-1));
  103.  
  104.         LHIborder4 : border = (0,0,2,0,JAM2,3,@LHIpairs4,@LHOBorder1);
  105.         LHIborder3 : border = (0,0,2,0,JAM2,3,@LHIpairs3,@LHIborder4);
  106.         LHIborder2 : border = (0,0,1,0,JAM2,3,@LHIpairs2,@LHIborder3);
  107.         LHIborder1 : border = (0,0,1,0,JAM2,3,@LHIpairs1,@LHIborder2);
  108.  
  109. {Gadget de longueur de structure}
  110.  
  111.         LInfo : StringInfo = ("100\0",
  112.                                      "   \0",
  113.                                      0,4,0,0,0,0,0,0,nil,100,nil);
  114. {Pour un STRGADGET du type LONGINT, cad qui contient uniquement un
  115.  nombre, il est preferable d'initialiser tout de suite le champs
  116.  'LongInt'}
  117.  
  118.         LText0 : intuitext = (1,0,JAM2,-65,0,@STDFont,"ongueur",nil);
  119.         LText  : intuitext = (1,0,JAM2,-73,0,@UDRFont,"L",@LText0);
  120.  
  121. L : Gadget = (nil,225,58,32,8,GADGHCOMP,RELVERIFY + GADGIMMEDIATE + LONGINT,
  122.                       STRGADGET,@LHIBorder1,nil,@LText,0,@LInfo,3,nil);
  123.  
  124. {Gadget de hauteur de structure}
  125.  
  126.         HInfo : StringInfo = ("100\0",
  127.                                      "   \0",
  128.                                      0,4,0,0,0,0,0,0,nil,100,nil);
  129.  
  130.         HText0 : intuitext = (1,0,JAM2,-65,0,@UDRFont,"H",nil);
  131.         HText  : intuitext = (1,0,JAM2,-57,0,@STDFont,"auteur",@HText0);
  132.  
  133. H : Gadget = (nil,225,77,32,8,GADGHCOMP,RELVERIFY + GADGIMMEDIATE + LONGINT,
  134.                       STRGADGET,@LHIBorder1,nil,@HText,0,@HInfo,4,nil);
  135.  
  136.  
  137.  
  138.         OText : intuitext = (1,0,JAM2,-62,0,@STDFont,"Offset",nil);
  139.         XText : intuitext = (1,0,JAM2,-14,0,@UDRFont,"X",@OText);
  140.         YText : intuitext = (1,0,JAM2,-14,0,@UDRFont,"Y",@OText);
  141.  
  142. {Gadget d'offset en X}
  143.  
  144.         XOInfo : StringInfo = ("0\0  ",
  145.                                       "   \0",
  146.                                       0,4,0,0,0,0,0,0,nil,0,nil);
  147.  
  148. XO : Gadget = (nil,327,58,32,8,GADGHCOMP,RELVERIFY + GADGIMMEDIATE + LONGINT,
  149.                         STRGADGET,@LHIBorder1,nil,@XText,0,@XOInfo,5,nil);
  150.  
  151. {Gadget d'offset en Y}
  152.  
  153.         YOInfo : StringInfo = ("0\0  ",
  154.                                       "   \0",
  155.                                       0,4,0,0,0,0,0,0,nil,0,nil);
  156.  
  157. YO : Gadget = (nil,327,77,32,8,GADGHCOMP,RELVERIFY + GADGIMMEDIATE + LONGINT,
  158.                         STRGADGET,@LHIBorder1,nil,@YText,0,@YOInfo,6,nil);
  159.  
  160. {Paires de points pour le gadget de choix du type de structure}
  161.  
  162.         Tpairs1 : array[1..3,1..2] of short = ((0,13),(0,0),(55,0));
  163.         Tpairs2 : array[1..3,1..2] of short = ((1,12),(1,0),(55,0));
  164.         Tpairs3 : array[1..3,1..2] of short = ((1,13),(56,13),(56,0));
  165.         Tpairs4 : array[1..3,1..2] of short = ((1,13),(55,13),(55,1));
  166.  
  167.         Tborder4 : border = (0,0,1,0,JAM2,3,@Tpairs4,@Cyclebord1);
  168.         Tborder3 : border = (0,0,1,0,JAM2,3,@Tpairs3,@Tborder4);
  169.         Tborder2 : border = (0,0,2,0,JAM2,3,@Tpairs2,@Tborder3);
  170.         Tborder1 : border = (0,0,2,0,JAM2,3,@Tpairs1,@Tborder2);
  171.  
  172.         HLTborder4 : border = (0,0,2,0,JAM2,3,@Tpairs4,@Cyclebord1);
  173.         HLTborder3 : border = (0,0,2,0,JAM2,3,@Tpairs3,@HLTborder4);
  174.         HLTborder2 : border = (0,0,1,0,JAM2,3,@Tpairs2,@HLTborder3);
  175.         HLTborder1 : border = (0,0,1,0,JAM2,3,@Tpairs1,@HLTborder2);
  176.  
  177. {Données pour le gadget de choix du type de structures}
  178.  
  179.         IN1_T  : intuitext = (1,0,JAM2,22,3,@STDFont,"IN1",nil);
  180.         IN2_T  : intuitext = (1,0,JAM2,22,3,@STDFont,"IN2",nil);
  181.         OUT1_T : intuitext = (1,0,JAM2,22,3,@STDFont,"OUT1",nil);
  182.         OUT2_T : intuitext = (1,0,JAM2,22,3,@STDFont,"OUT2",nil);
  183.  
  184.         CGT4 : CycleGad_Text = (@OUT2_T,4,nil);
  185.         CGT3 : CycleGad_Text = (@OUT1_T,3,@CGT4);
  186.         CGT2 : CycleGad_Text = (@IN2_T,2,@CGT3);
  187.         CGT1 : CycleGad_Text = (@IN1_T,1,@CGT2);
  188.  
  189. {Gadget de choix du type de structure}
  190.  
  191.         CGTg : gadget = (nil,92,64,57,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE,
  192.                               BOOLGADGET,@Tborder1,@HLTborder1,@IN1_T,0,nil,7,@CGT1);
  193.  
  194.         TText0 : intuitext = (1,0,JAM2,8,63,@UDRFont,"T",nil);
  195.         TText1 : intuitext = (1,0,JAM2,16,63,@STDFont,"ype de la",@TText0);
  196.         TText2 : intuitext = (1,0,JAM2,16,72,@STDFont,"Structure",@TText1);
  197.  
  198. {Paires de points pour le gadget d'écriture}
  199.  
  200.         Epairs1 : array[1..3,1..2] of short = ((0,13),(0,0),(94,0));
  201.         Epairs2 : array[1..3,1..2] of short = ((1,12),(1,0),(94,0));
  202.         Epairs3 : array[1..3,1..2] of short = ((1,13),(95,13),(95,0));
  203.         Epairs4 : array[1..3,1..2] of short = ((1,13),(94,13),(94,1));
  204.  
  205.         Eborder4 : border = (0,0,1,0,JAM2,3,@Epairs4,nil);
  206.         Eborder3 : border = (0,0,1,0,JAM2,3,@Epairs3,@Eborder4);
  207.         Eborder2 : border = (0,0,2,0,JAM2,3,@Epairs2,@Eborder3);
  208.         Eborder1 : border = (0,0,2,0,JAM2,3,@Epairs1,@Eborder2);
  209.  
  210.         Ehlborder4 : border = (0,0,2,0,JAM2,3,@Epairs4,nil);
  211.         Ehlborder3 : border = (0,0,2,0,JAM2,3,@Epairs3,@Ehlborder4);
  212.         Ehlborder2 : border = (0,0,1,0,JAM2,3,@Epairs2,@Ehlborder3);
  213.         Ehlborder1 : border = (0,0,1,0,JAM2,3,@Epairs1,@Ehlborder2);
  214.  
  215. { Gadget d'écriture }
  216.  
  217.         EText0 : intuitext = (1,0,JAM2,25,3,@UDRFont,"E",nil);
  218.         EText  : intuitext = (1,0,JAM2,33,3,@STDFont,"crire",@EText0);
  219.  
  220.         E : gadget = (nil,40,93,96,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE,
  221.                           BOOLGADGET,@Eborder1,@Ehlborder1,@EText,0,nil,8,nil);
  222.  
  223. { Gadget de complement }
  224.  
  225.         CText0 : intuitext = (1,0,JAM2,9,3,@UDRFont,"C",nil);
  226.         CText  : intuitext = (1,0,JAM2,17,3,@STDFont,"omplement",@CText0);
  227.  
  228.         C : gadget = (nil,228,93,96,14,GADGHIMAGE,RELVERIFY+GADGIMMEDIATE,
  229.                           BOOLGADGET,@Eborder1,@Ehlborder1,@CText,0,nil,9,nil);
  230.  
  231. {Chaînes de caractéres pour l'écriture}
  232.  
  233.         strpairs : array[1..3,1..2] of string = ( (",","),(") , (",","),(") , (",","));"));
  234.         deb : string = "    ";
  235.  
  236. ReqErr0 : intuitext = (0,1,JAM2,71,10,@STDFont,"J'ai besoin de la",nil);
  237. ReqErr1 : intuitext = (0,1,JAM2,75,20,@STDFont,"ReqTools library",@ReqErr0);
  238. ReqErr2 : intuitext = (0,1,JAM2,71,30,@STDFont,"   V38 ou plus   ",@ReqErr1);
  239.  
  240. WinErr0 : intuitext = (0,1,JAM2,75,10,@STDFont," Je ne peut pas ",nil);
  241. WinErr1 : intuitext = (0,1,JAM2,71,20,@STDFont,"ouvrir de fenêtre",@WinErr0);
  242. WinErr2 : intuitext = (0,1,JAM2,71,30,@STDFont,"   Intuition!!   ",@WinErr1);
  243.  
  244.         Okay     : intuitext = (0,1,JAM2,6,3,@STDFont,"Continuer",nil);
  245.  
  246.  
  247. VAR
  248.     w            : windowptr;
  249.     im         : intuimessageptr;
  250.     quit,ok    : boolean;
  251.     mode        : integer;
  252.     filename : string;
  253.     filereq    : rtfilerequesterptr;
  254.     mytag     : reqtaglistptr;
  255.  
  256. PROCEDURE Ecrire;
  257.  
  258. VAR
  259.     fh             : filehandle;
  260.     fl             : filelock;
  261.     derr,i,j,
  262.     k,front,ret : integer;
  263.     s                : string;
  264.     ok             : boolean;
  265.     t                : array[1..4,1..3,1..2] of short;
  266.  
  267.   PROCEDURE compose_tab(x,y : integer);
  268.  
  269. {Ici, on compose le tableau t qui contient les paires de points.
  270.  Pourquoi x et y?
  271.  A droite et à gauche, les bords occupent deux pixels,
  272.  en haut et en bas, 1 pixel.
  273.  C'est pourquoi, pour les types 'In2' et 'Out2', il faut décaler
  274.  de deux pixels vers le bas, deux pixels vers le haut, 1 vers la
  275.  droite et un vers la gauche!}
  276.  
  277.   BEGIN
  278.  
  279.         t[1,1,1] := xoinfo.longint + x;
  280.         t[1,1,2] := yoinfo.longint + hinfo.longint - y - 1;
  281.  
  282.         t[1,2,1] := xoinfo.longint + x;
  283.         t[1,2,2] := yoinfo.longint + y;
  284.  
  285.         t[1,3,1] := xoinfo.longint + linfo.longint - 2 - x;
  286.         t[1,3,2] := yoinfo.longint + y;
  287.  
  288.         t[2,1,1] := xoinfo.longint + 1 + x;
  289.         t[2,1,2] := yoinfo.longint + hinfo.longint - 2 - y;
  290.  
  291.         t[2,2,1] := xoinfo.longint + 1 + x;
  292.         t[2,2,2] := yoinfo.longint + y;
  293.  
  294.         t[2,3,1] := xoinfo.longint + linfo.longint - 2 - x;
  295.         t[2,3,2] := yoinfo.longint + y;
  296.  
  297.         t[3,1,1] := xoinfo.longint + 1 + x;
  298.         t[3,1,2] := yoinfo.longint + hinfo.longint - y - 1;
  299.  
  300.         t[3,2,1] := xoinfo.longint + linfo.longint - x - 1;
  301.         t[3,2,2] := yoinfo.longint + hinfo.longint - y - 1;
  302.  
  303.         t[3,3,1] := xoinfo.longint + linfo.longint - x - 1;
  304.         t[3,3,2] := yoinfo.longint + y;
  305.  
  306.         t[4,1,1] := xoinfo.longint + 1 + x;
  307.         t[4,1,2] := yoinfo.longint + hinfo.longint - y - 1;
  308.  
  309.         t[4,2,1] := xoinfo.longint + linfo.longint - 2 - x;
  310.         t[4,2,2] := yoinfo.longint + hinfo.longint - y - 1;
  311.  
  312.         t[4,3,1] := xoinfo.longint + linfo.longint - 2 - x;
  313.         t[4,3,2] := yoinfo.longint + 1 + y;
  314.  
  315.     END;
  316.  
  317. BEGIN
  318.     k := rtsetwaitpointer(w);
  319.     s := allocstring(10);
  320.     deb[0] := chr(10);
  321.     derr := 0;
  322.     fl := lock(FInfo.buffer,SHARED_LOCK);
  323.     if fl<>nil then
  324.     begin
  325.         unlock(fl);
  326.         mytag^[0].ti_tag    := RT_Underscore;
  327.         mytag^[0].ti_data := integer('_');
  328.         mytag^[1].ti_tag    := TAG_END;
  329.         ret := rtEZRequestA("Le fichier\n%s\nexiste. Faut-il",
  330.                 " le _Remplacer | faire _Suivre | _Annuler ",nil,@FInfo.buffer,mytag);
  331.         case ret of
  332.             1: fh := dosopen(FInfo.buffer,MODE_NEWFILE);
  333.             2: fh := dosopen(FInfo.buffer,MODE_OLDFILE);
  334.             3: begin clearpointer(w); return; end;
  335.         end;
  336.     end
  337.     else
  338.         fh := dosopen(FInfo.buffer,MODE_NEWFILE);
  339.     IF fh=nil THEN
  340.     BEGIN
  341.         clearpointer(w);
  342.         derr := ioerr;
  343.         mytag^[0].ti_tag    := RT_Underscore;
  344.         mytag^[0].ti_data := integer('_');
  345.         mytag^[1].ti_tag    := TAG_END;
  346.         ret := rtEZRequestA("Erreur Systême\n%ld",
  347.                     " _Continuer ",nil,@derr,mytag);
  348.         freestring(s);
  349.         return;
  350.     END
  351.     ELSE
  352.     BEGIN
  353.         derr := seek(fh,0,OFFSET_END);
  354.         if ret=2 then
  355.             derr := doswrite(fh,"\n",1);
  356.         compose_tab(0,0);
  357.         FOR k := 1 TO 4 DO {Un seul tableau nous permet l'usage d'une boucle}
  358.         BEGIN                  {Pour écrire les paires de points}
  359. {On prend comme nom de structrure 'Essai' pour commenter pas à pas
  360.  ce qu'on écrite dans le fichier}
  361. {'\n' correspond au code ASCII 10}
  362.             derr := doswrite(fh,deb,4);                                             {"\n   "}
  363.             derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));         {"Essai"}
  364.             derr := doswrite(fh,"Pairs",5);                                         {"Pairs"}
  365.             derr := inttostr(s,k);
  366.             derr := doswrite(fh,s,1);                                      {"1"/"2"/"3"/"4"}
  367.             derr := doswrite(fh," :array[1..3,1..2] of short = ((",32);
  368.                                                         {" : array[1..3,1..2] of short = (("}
  369.             FOR i := 1 TO 3 DO
  370.                 FOR j := 1 TO 2 DO
  371.                 BEGIN
  372.                     derr := inttostr(s,t[k,i,j]);         {On écrit ici les paires de}
  373.                     derr := doswrite(fh,s,strlen(s)); {Points definies précedemment}
  374.                     derr := doswrite(fh,strpairs[i,j],strlen(strpairs[i,j]));
  375.                 END;
  376.         END;
  377.  
  378.         derr := doswrite(fh,deb,1);                                                     {"\n"}
  379.  
  380.         IF ( (mode = 2) OR (mode = 4) ) THEN    {mode 2 : 'In2' - mode 4 : 'Out2'}
  381.         BEGIN
  382.             compose_tab(2,1);                                      {On compose en décalant}
  383.             FOR k := 1 TO 4 DO
  384.             BEGIN
  385.                 derr := doswrite(fh,deb,4);                                         {"\n   "}
  386.                 derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));     {"Essai"}
  387.                 derr := doswrite(fh,"Pairs",5);                                     {"Pairs"}
  388.                 derr := doswrite(fh,"In",2);                                             {"In"}
  389.                 derr := inttostr(s,k);
  390.                 derr := doswrite(fh,s,1);                                  {"1"/"2"/"3"/"4"}
  391.                 derr := doswrite(fh," :array[1..3,1..2] of short = ((",32);
  392.                                                         {" : array[1..3,1..2] of short = (("}
  393.                 FOR i := 1 TO 3 DO
  394.                     FOR j := 1 TO 2 DO
  395.                     BEGIN
  396.                         derr := inttostr(s,t[k,i,j]);     {On écrit ici les paires de}
  397.                         derr := doswrite(fh,s,strlen(s));{Points definies précedemment}
  398.                         derr := doswrite(fh,strpairs[i,j],strlen(strpairs[i,j]));
  399.                     END;
  400.             END;
  401.  
  402.             derr := doswrite(fh,deb,1);                                                 {"\n"}
  403.  
  404.             FOR i := 4 DOWNTO 1 DO
  405.             BEGIN
  406.                 IF (
  407.                     ((i = 4) AND (mode = 4))
  408.                     OR
  409.                     ((i = 2) AND (mode = 2))
  410.                     )
  411.                 THEN
  412.                     front := 1
  413.                 ELSE
  414.                 IF (
  415.                     ((i = 4) AND (mode = 2))
  416.                     OR
  417.                     ((i = 2) AND (mode = 4))
  418.                     )
  419.                 THEN
  420.                     front := 2;
  421.                 derr := doswrite(fh,deb,4);                                         {"\n   "}
  422.                 derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));     {"Essai"}
  423.                 derr := doswrite(fh,"Border",6);                                 {"Border"}
  424.                 derr := doswrite(fh,"In",2);                                             {"In"}
  425.                 derr := inttostr(s,i);
  426.                 derr := doswrite(fh,s,derr);                              {"4"/"3"/"2"/"1"}
  427.                 derr := doswrite(fh," : border = (0,0,",17);  {" : border = (0,0,"}
  428.                 derr := inttostr(s,front);
  429.                 derr := doswrite(fh,s,derr);                            {Couleur du dessin}
  430.                 derr := doswrite(fh,",0",2);    {",0"  0 ->Couleur du fond du dessin}
  431.                 derr := doswrite(fh,",JAM2,3,@",9);                         {",JAM2,3,@"}
  432.                 derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));     {"Essai"}
  433.                 derr := doswrite(fh,"pairs",5);                                     {"pairs"}
  434.                 derr := doswrite(fh,"In",2);                                             {"In"}
  435.                 derr := inttostr(s,i);
  436.                 derr := doswrite(fh,s,derr);                              {"4"/"3"/"2"/"1"}
  437.                 derr := doswrite(fh,",",1);                                              {","}
  438.                 IF i=4 THEN                                             {i = 4 ==> rien avant}
  439.                     derr := doswrite(fh,"nil",3)                                        {"nil"}
  440.                 ELSE                                                                            {sinon}
  441.                 BEGIN
  442.                     derr := doswrite(fh,"@",1);                                          {"@"}
  443.                     derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));{"Essai"}
  444.                     derr := doswrite(fh,"BorderIn",8);                         {"BorderIn"}
  445.                     derr := inttostr(s,i+1);
  446.                     derr := doswrite(fh,s,derr);                                {"3"/"2"/"1"}
  447.                 END;
  448.                 derr := doswrite(fh,");",2);                                             {");"}
  449.             END;
  450.             derr := doswrite(fh,deb,1);                                                 {"\n"}
  451.         END;
  452.  
  453.         FOR i := 4 DOWNTO 1 DO
  454.         BEGIN
  455.             IF (
  456.                 ( (i = 4) AND ((mode = 3) OR (mode=2)) )
  457.                 OR
  458.                 ( (i = 2) AND ((mode = 1) OR (mode=4)) )
  459.                 )
  460.             THEN
  461.                 front := 1
  462.             ELSE
  463.             IF (
  464.                 ( (i = 4) AND ((mode = 1) OR (mode=4)) )
  465.                 OR
  466.                 ( (i = 2) AND ((mode = 2) OR (mode=3)) )
  467.                 )
  468.             THEN
  469.                 front := 2;
  470.             derr := doswrite(fh,deb,4);                                             {"\n   "}
  471.             derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));         {"Essai"}
  472.             derr := doswrite(fh,"Border",6);                                     {"Border"}
  473.             derr := inttostr(s,i);
  474.             derr := doswrite(fh,s,derr);                                  {"4"/"3"/"2"/"1"}
  475.             derr := doswrite(fh," : border = (0,0,",17);      {" : border = (0,0,"}
  476.             derr := inttostr(s,front);
  477.             derr := doswrite(fh,s,derr);                                {Couleur du dessin}
  478.             derr := doswrite(fh,",0",2);        {",0"  0 ->Couleur du fond du dessin}
  479.             derr := doswrite(fh,",JAM2,3,@",9);                             {",JAM2,3,@"}
  480.             derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));         {"Essai"}
  481.             derr := doswrite(fh,"pairs",5);                                         {"pairs"}
  482.             derr := inttostr(s,i);
  483.             derr := doswrite(fh,s,derr);                                  {"4"/"3"/"2"/"1"}
  484.             derr := doswrite(fh,",",1);
  485.             IF (
  486.                 (i = 4)
  487.                 AND
  488.                 ((mode = 1) OR (mode = 3))
  489.                 )
  490.             THEN
  491.               derr := doswrite(fh,"nil",3)                                            {"nil"}
  492.             ELSE
  493.             IF (
  494.                 (i = 4)
  495.                 AND
  496.                 ((mode = 2) OR (mode = 4))
  497.                 )
  498.             THEN
  499.             BEGIN
  500.                 derr := doswrite(fh,"@",1);                                              {"@"}
  501.                 derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));     {"Essai"}
  502.                 derr := doswrite(fh,"BorderIn",8);                             {"BorderIn"}
  503.                 derr := inttostr(s,1);
  504.                 derr := doswrite(fh,s,derr);                                    {"3"/"2"/"1"}
  505.             END
  506.             ELSE
  507.             BEGIN
  508.                 derr := doswrite(fh,"@",1);                                              {"@"}
  509.                 derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));     {"Essai"}
  510.                 derr := doswrite(fh,"Border",6);                                 {"Border"}
  511.                 derr := inttostr(s,i+1);
  512.                 derr := doswrite(fh,s,derr);                                    {"3"/"2"/"1"}
  513.             END;
  514.             derr := doswrite(fh,");",2);                                                 {");"}
  515.         END;
  516.  
  517.         IF C.flags = GADGHIMAGE + SELECTED THEN
  518.         BEGIN
  519.             derr := doswrite(fh,deb,1);                                                 {"\n"}
  520.             FOR i := 4 DOWNTO 1 DO
  521.             BEGIN
  522.                 IF (
  523.                     ( (i = 4) AND (mode = 1) )
  524.                     OR
  525.                     ( (i = 2) AND (mode = 3) )
  526.                     )
  527.                 THEN
  528.                     front := 1
  529.                 ELSE
  530.                 IF (
  531.                     ( (i = 4) AND (mode = 3) )
  532.                     OR
  533.                     ( (i = 2) AND (mode = 1) )
  534.                     )
  535.                 THEN
  536.                     front := 2;
  537.                 derr := doswrite(fh,deb,4);                                         {"\n   "}
  538.                 derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));     {"Essai"}
  539.                 derr := doswrite(fh,"Border",6);                                 {"Border"}
  540.                 derr := doswrite(fh,"HL",2);                                             {"HL"}
  541.                 derr := inttostr(s,i);
  542.                 derr := doswrite(fh,s,derr);                              {"4"/"3"/"2"/"1"}
  543.                 derr := doswrite(fh," : border = (0,0,",17);  {" : border = (0,0,"}
  544.                 derr := inttostr(s,front);
  545.                 derr := doswrite(fh,s,derr);                            {Couleur du dessin}
  546.                 derr := doswrite(fh,",0",2);    {",0"  0 ->Couleur du fond du dessin}
  547.                 derr := doswrite(fh,",JAM2,3,@",9);                         {",JAM2,3,@"}
  548.                 derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));     {"Essai"}
  549.                 derr := doswrite(fh,"pairs",5);                                     {"pairs"}
  550.                 derr := inttostr(s,i);
  551.                 derr := doswrite(fh,s,derr);                              {"4"/"3"/"2"/"1"}
  552.                 derr := doswrite(fh,",",1);
  553.                 IF
  554.                     (i = 4)
  555.                 THEN
  556.                   derr := doswrite(fh,"nil",3)                                        {"nil"}
  557.                 ELSE
  558.                 BEGIN
  559.                     derr := doswrite(fh,"@",1);                                          {"@"}
  560.                     derr := doswrite(fh,SInfo.buffer,strlen(SInfo.buffer));{"Essai"}
  561.                     derr := doswrite(fh,"BorderHL",8);                         {"BorderHL"}
  562.                     derr := inttostr(s,i+1);
  563.                     derr := doswrite(fh,s,derr);                                {"4"/"3"/"2"}
  564.                 END;
  565.                 derr := doswrite(fh,");",2);                                             {");"}
  566.             END;
  567.         END;
  568.  
  569.     END;
  570.     freestring(s);
  571.     dosclose(fh);
  572.     clearpointer(w);
  573. END;
  574.  
  575. PROCEDURE ouvre_tout;
  576.  
  577. VAR
  578.     cond : boolean;
  579.  
  580. BEGIN
  581.  
  582.     RTBase := ReqToolsBasePtr(OpenLibrary(REQTOOLSNAME,REQTOOLSVERSION));
  583.     IF RTBase=nil THEN
  584.     BEGIN
  585.         cond := autorequest(w,@ReqErr2,@Okay,@Okay,REQGADGET,REQGADGET,300,80);
  586.         exit(20);
  587.     END;
  588.  
  589.     w := openwindow(@win);
  590.     IF w=nil THEN
  591.     BEGIN
  592.         cond := autorequest(w,@WinErr2,@Okay,@Okay,REQGADGET,REQGADGET,300,80);
  593.         exit(20);
  594.     END;
  595.  
  596.     quit := false;
  597.  
  598.     filename := allocstring(108);
  599.     strcpy(filename,"");
  600.  
  601.     GetMem(mytag,sizeof(reqtaglistptr));
  602.  
  603.     CGT4.next := @CGT1;
  604.  
  605.     if addgadget(w,@S,-1) = 0 then;
  606.     if addgadget(w,@F,-1) = 0 then;
  607.     if addgadget(w,@CGTg,-1) = 0 then;
  608.     if addgadget(w,@L,-1) = 0 then;
  609.     if addgadget(w,@H,-1) = 0 then;
  610.     if addgadget(w,@XO,-1) = 0 then;
  611.     if addgadget(w,@YO,-1) = 0 then;
  612.     if addgadget(w,@E,-1) = 0 then;
  613.     if addgadget(w,@C,-1) = 0 then;
  614.  
  615.     refreshgadgets(w^.firstgadget,w,nil);
  616.  
  617.     printitext(w^.rport,@TText2,0,0);
  618.  
  619.     mode := 1;
  620.  
  621. END;
  622.  
  623. PROCEDURE ChgTyp;
  624. BEGIN                   {Changement de mode}
  625.     CG_CycleText(CGTg,w);
  626.     mode := CG_GetId(CGTg);
  627.     IF ((mode = 2) OR (mode = 4)) THEN
  628.         IF (C.flags = GADGHIMAGE + SELECTED) THEN
  629.         BEGIN                         {Deselection de la complementarité si besoin est}
  630.             C.flags := GADGHIMAGE;
  631.             refreshgadgets(@C,w,nil);
  632.         END;
  633. END;
  634.  
  635. PROCEDURE Complemente;
  636. BEGIN                             {On selectionne ou deselectionne la complementarité}
  637.  
  638.     mode := CG_GetId(CGTg);
  639.     IF ((mode = 1) OR (mode = 3)) THEN
  640.         IF C.flags = GADGHIMAGE THEN
  641.             C.flags := GADGHIMAGE + SELECTED                                 {    Selection}
  642.         ELSE
  643.             C.flags := GADGHIMAGE;                                                {DeSelection}
  644. END;
  645.  
  646. PROCEDURE FReq;
  647.  
  648. VAR
  649.     ret      : integer;
  650.  
  651. BEGIN
  652.     filereq := Address(rtAllocRequestA (RT_FILEREQ, NIL));
  653.     IF filereq<>nil THEN
  654.     BEGIN
  655.         mytag^[0].ti_tag    := RT_Window;
  656.         mytag^[0].ti_data := integer(w);
  657.         mytag^[1].ti_tag    := RT_LockWindow;
  658.         mytag^[1].ti_data := integer(TRUE);
  659.         mytag^[2].ti_tag    := TAG_END;
  660.         ret := rtFileRequestA(filereq,filename,"Choisissez un fichier",mytag);
  661.         IF ret = 1 THEN
  662.         BEGIN
  663.             strcpy(FInfo.buffer,filereq^.dir);
  664.             strcat(FInfo.buffer,filename);
  665.             refreshgadgets(@F,w,nil);
  666.         END;
  667.         ret := rtFreeRequest(filereq);
  668.     END;
  669. END;
  670.  
  671. FUNCTION EndReq:boolean;
  672.  
  673. VAR
  674.     ret     : integer;
  675.     endtag : reqtaglistptr;
  676.  
  677. BEGIN
  678.     mytag^[0].ti_tag    := RT_Underscore;
  679.     mytag^[0].ti_data := integer('_');
  680.     mytag^[1].ti_tag    := TAG_END;
  681.     ret := rtEZRequestA("Etes-vous sûr de vouloir\nquitter BorderMaker",
  682.                               " _Continuer | Oh _Non ",nil,nil,mytag);
  683.     IF ret = 1 THEN
  684.         EndReq := true
  685.     ELSE
  686.         EndReq := false;
  687. END;
  688.  
  689. PROCEDURE Puis_Je_Ecrire;
  690.  
  691. BEGIN
  692.     WHILE strcmp(FInfo.buffer,"")=0 DO
  693.         FReq;
  694.     ecrire;
  695. END;
  696.  
  697. BEGIN
  698.  
  699.     ouvre_tout;
  700.  
  701.     REPEAT
  702.         im := intuimessageptr(waitport(w^.userport));        {On attend un message}
  703. im := intuimessageptr(getmsg(w^.userport));{Quand il y en a un, on le recupére}
  704.  
  705.         CASE im^.class OF
  706.             CLOSEWINDOW_f    :    {Crapoto basta fuite : au revoir}
  707.  
  708.                                     quit := EndReq;
  709.  
  710.                         {Un petit requester pour verifier si la sortie est voulue...}
  711.  
  712.             GADGETUP_f        :    BEGIN
  713.  
  714.                                         CASE gadgetptr(im^.iaddress)^.gadgetid of
  715.  
  716.                                             7    :    ChgTyp;                    {On change le type}
  717.  
  718.         {    Pour les 'STRGADET', le code 'GADGETUP_f' correspond à l'appui sur la}
  719.         {touche 'Return' ou la touche 'Enter'. On active donc le 'STRGADGET' qui}
  720.         {                                                     vient le plus logiquement après.}
  721.  
  722.                                             1    :    ok := activategadget(@S,w,nil);
  723.                  {On sort du nom de fichier, on rentre dans le nom de la structure}
  724.  
  725.                                             2    :    ok := activategadget(@L,w,nil);
  726.                              {On sort du nom de structure, on rentre dans la longueur}
  727.  
  728.                                             3    :    ok := activategadget(@XO,w,nil);
  729.                                  {On sort de la longueur, on rentre dans l'offset en X}
  730.  
  731.                                             5    :    ok := activategadget(@H,w,nil);
  732.                                   {On sort de l'offset en X, on rentre dans la hauteur}
  733.  
  734.                                             4    :    ok := activategadget(@YO,w,nil);
  735.                                   {On sort de la hauteur, on rentre dans l'offset en Y}
  736.  
  737.                                         END;
  738.  
  739.                                     END;
  740.  
  741.             GADGETDOWN_F    :    BEGIN
  742.  
  743.                                         CASE gadgetptr(im^.iaddress)^.gadgetid OF
  744.  
  745.                                             8    :    Puis_Je_Ecrire;{On ecrit le code source}
  746.  
  747.                                             9    :    Complemente;
  748.  
  749.                                             1    :    FReq;
  750.  
  751.                                         END;
  752.  
  753.                                     END;
  754.  
  755.             RAWKEY_f         :    BEGIN
  756.  
  757.                                         CASE im^.code of
  758.  
  759.                                             18 :    Puis_Je_Ecrire;
  760.  
  761.                                             20 :    ChgTyp;
  762.  
  763.                                             51 :    BEGIN
  764.                                                         Complemente;
  765.                                                         refreshgadgets(@C,w,nil);
  766.                                                     END;
  767.  
  768.                                             40 :    ok := activategadget(@L,w,nil);
  769.  
  770.                                             37 :    ok := activategadget(@H,w,nil);
  771.  
  772.                                             50 :    ok := activategadget(@XO,w,nil);
  773.  
  774.                                             21 :    ok := activategadget(@YO,w,nil);
  775.  
  776.                                             33 :    ok := activategadget(@S,w,nil);
  777.  
  778.                                             35 :    FReq;
  779.  
  780.                                             69 :    {Crapoto basta fuite : au revoir}
  781.  
  782.                                                     quit := EndReq;
  783.  
  784.                         {Un petit requester pour verifier si la sortie est voulue...}
  785.                                         END;
  786.                                     END;
  787.         END;
  788.  
  789.         replymsg(messageptr(im));
  790.     UNTIL quit;
  791.     freestring(filename);
  792.     FreePCQMem(mytag,sizeof(reqtaglistptr));
  793.     CloseLibrary(LibraryPtr(RTBase));
  794.     closewindow(w);
  795. END.
  796.